home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / magic / i / mttrees.i < prev    next >
Encoding:
Modula Implementation  |  1997-10-26  |  8.6 KB  |  311 lines
  1. (*----------------------------------------------------------------------*
  2.  *                                                                      *
  3.  *  MAGICTOOLS   Modula's  All purpose  GEM  Interface  Cadre  Toolbox  *
  4.  *               ÿ         ÿ            ÿ    ÿ          ÿ               *
  5.  *----------------------------------------------------------------------*
  6.  * Version 3.30  02.02.1992     (C)90/91/92 by Peter Hellinger Software *
  7.  *----------------------------------------------------------------------*
  8.  *            Dieses Modul ist urheberrechtlich geschtzt.              *
  9.  *                                                                      *
  10.  * Die Ver”ffentlichung des Quelltextes oder Teilen daraus, sowie die   *
  11.  * Verbreitung des bersetzten, nicht gelinkten Codes in schriftlicher, *
  12.  * oder maschinenlesbarer Form, insbesondere in Zeitschriften, Mail-    *
  13.  * boxen oder anderen Medien bedarf der ausdrcklichen schriftlichen    *
  14.  * Einverst„ndnisserkl„rung des Autors.                                 *
  15.  *                                                                      *
  16.  * Die Verbreitung des Moduls als Teil eines gelinkten Programms ist    *
  17.  * fr Lizenznehmer ausdrcklich erlaubt!  Der Autor beh„lt sich das    *
  18.  * Recht vor, diese Erlaubnis jederzeit und ohne Angaben von Grnden zu *
  19.  * widerrufen.                                                          *
  20.  *----------------------------------------------------------------------*)
  21.  
  22. IMPLEMENTATION MODULE mtTrees;
  23.  
  24. (*----------------------------------------------------------------------*
  25.  * Int. Vers | Datum    | Name | Žnderung                               *
  26.  *-----------+----------+------+----------------------------------------*
  27.  *  3.00     | 18.01.92 |  Hp  |                                        *
  28.  *-----------+----------+------+----------------------------------------*)
  29.  
  30.  
  31.  
  32. (* IMPLEMENTATION FšR  >>> Megamax-Modula-2 <<< *)
  33. (*                                              *)
  34. (*$R-   Range-Checks                            *)
  35. (*$S-   Stack-Check                             *)
  36. (*                                              *)
  37. (*----------------------------------------------*)
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44. FROM MagicSys   IMPORT  Nil, Null, Bit0, Bit1, Bit2, Bit3, Bit4, Bit5, Bit6,
  45.                         Bit7, Bit8, Bit9, Bit10, Bit11, Bit12, Bit13, Bit14,
  46.                         Bit15, LOC, Byte, ByteSet, sWORD, sINTEGER, sCARDINAL,
  47.                         sBITSET, lINTEGER, lCARDINAL, lWORD, lBITSET,
  48.                         CastToChar, CastToByte, CastToByteset, CastToInt,
  49.                         CastToCard, CastToBitset, CastToWord, CastToLInt,
  50.                         CastToLCard, CastToLBitset, CastToLWord, CastToAddr,
  51.                         TosVersion, Accessory, Basepage, SysHeader, TosDate;
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  61.  
  62.  
  63.  
  64.  
  65. FROM SYSTEM     IMPORT  ADDRESS, ADR, TSIZE;
  66.  
  67. CONST   cMax =          07FFFH;
  68.  
  69. TYPE    INFO =          POINTER TO ARRAY [0..cMax] OF LOC;
  70.  
  71. TYPE    NODE =          POINTER TO Node;
  72.         Node =          RECORD
  73.                          addr:  INFO;
  74.                          size:  sCARDINAL;
  75.                          left:  NODE;
  76.                          right: NODE;
  77.                          back:  NODE;
  78.                         END;
  79.  
  80. TYPE    TREE =          POINTER TO Tree;
  81.         Tree =          RECORD
  82.                          root:  NODE;
  83.                          comp:  CompProc;
  84.                          entry: lCARDINAL;
  85.                         END;
  86.  
  87. PROCEDURE Copy (from, to: INFO; size: CARDINAL);
  88. VAR c: CARDINAL;
  89. BEGIN
  90.  FOR c:= 0 TO size DO to^[c]:= from^[c]; END;
  91. END Copy;
  92.  
  93. PROCEDURE NewTree (VAR tree: TREE; comp: CompProc): BOOLEAN;
  94. BEGIN
  95.  ALLOCATE (tree,  TSIZE (Tree));  
  96.  IF tree = NIL THEN RETURN FALSE; END;
  97.  tree^.root:=  NIL;  tree^.comp:= comp;  tree^.entry:= LONG (0);
  98.  RETURN TRUE;
  99. END NewTree;
  100.  
  101. PROCEDURE DisposeTree (VAR tree: TREE);
  102. VAR p: NODE;
  103. BEGIN
  104.  IF tree # NIL THEN
  105.   WITH tree^ DO
  106.    (* Wieso steht hier eigentlich nichts? *)
  107.   END;
  108.   DEALLOCATE (tree, 0);  
  109.  END;
  110. END DisposeTree;
  111.  
  112. PROCEDURE TreeEntries (tree: TREE): lCARDINAL;
  113. BEGIN
  114.  IF tree = NIL THEN  RETURN LONG (0);
  115.                ELSE  RETURN tree^.entry;
  116.  END;
  117. END TreeEntries;
  118.  
  119. PROCEDURE NilNode (): NODE;
  120. BEGIN
  121.  RETURN NIL;
  122. END NilNode;
  123.  
  124. PROCEDURE InsertNode (tree: TREE; info: ARRAY OF LOC): BOOLEAN;
  125. VAR p, q, n: NODE;
  126.     cmp: CompResult;
  127.     dir:     (l, r);
  128.  
  129.  PROCEDURE NewNode (): NODE;
  130.  VAR t: NODE;
  131.  BEGIN
  132.   ALLOCATE (t,  TSIZE (Node));  
  133.   IF t = NIL THEN  RETURN NIL;  END;
  134.   t^.size:= HIGH (info);
  135.   t^.left:= NIL;  t^.right:= NIL;  t^.back:= NIL;
  136.   ALLOCATE (t^.addr,  LONG (t^.size));  
  137.   IF t^.addr = NIL THEN  DEALLOCATE (t, 0);    RETURN NIL;  END;
  138.   Copy (ADR(info), t^.addr, t^.size);
  139.   RETURN t;
  140.  END NewNode;
  141.  
  142. BEGIN
  143.  IF tree = NIL THEN  RETURN FALSE;  END;
  144.  n:= NewNode ();
  145.  IF n = NIL THEN  RETURN FALSE;  END;
  146.  WITH tree^ DO
  147.   p:= root;  q:= p;
  148.   WHILE p # NIL DO
  149.    q:= p;
  150.    cmp:= comp (n^.addr, p^.addr);
  151.    CASE cmp OF
  152.     smaller: dir:= l;  p:= p^.left;|
  153.     bigger:  dir:= r;  p:= p^.right;|
  154.     ELSE     RETURN FALSE; (* Element existiert bereits! *)
  155.    END;
  156.   END; (* WHILE *)
  157.   n^.back:= q;
  158.   IF q # NIL THEN
  159.    IF dir = l THEN  q^.left:= n;  ELSE  q^.right:= n;  END;
  160.   ELSE
  161.    root:= n;
  162.   END;
  163.  END;
  164.  INC (tree^.entry);
  165.  RETURN TRUE;
  166. END InsertNode;
  167.  
  168. PROCEDURE SearchNode (tree: TREE; from: NODE; info: ARRAY OF LOC;
  169.                       key: CompProc): NODE;
  170. VAR ok: BOOLEAN;
  171.     cmp: CompResult;
  172.     p, q: NODE;
  173. BEGIN
  174.  IF tree = NIL THEN  RETURN NIL;  END;
  175.  WITH tree^ DO
  176.   p:= root;  q:= root;  ok:= FALSE;
  177.   IF from # NIL THEN  p:= from;  q:= from;
  178.                 ELSE  p:= root;  q:= root;
  179.   END;              
  180.   WHILE p # NIL DO
  181.    q:= p;
  182.    cmp:= key (ADR (info), p^.addr);
  183.    CASE cmp OF
  184.     equal:     RETURN p;|
  185.     smaller:   p:= p^.left;|
  186.     bigger:    p:= p^.right;|
  187.    END;
  188.   END; (* WHILE *)
  189.  END; (* WITH *)
  190.  RETURN NIL;
  191. END SearchNode;
  192.  
  193. PROCEDURE DeleteNode (tree: TREE; VAR node: NODE);
  194. VAR q, p, t: NODE;
  195.     inf: INFO;
  196.  
  197.  PROCEDURE Del (VAR x: NODE);
  198.  BEGIN
  199.   DEALLOCATE (x^.addr, 0);  
  200.   DEALLOCATE (x, 0);  
  201.   x:= NIL;
  202.  END Del;
  203.  
  204.  PROCEDURE Putback (VAR x: NODE; y: NODE);
  205.  BEGIN
  206.   IF x^.back # NIL THEN
  207.    WITH x^.back^ DO
  208.     IF left = x THEN  left:= y;  ELSE  right:= y;  END;
  209.    END;
  210.   END;
  211.   IF y # NIL THEN y^.back:= x^.back; END;
  212.  END Putback;
  213.  
  214. BEGIN
  215.  IF (tree = NIL) OR (node = NIL) THEN  RETURN;  END;
  216.  WITH tree^ DO
  217.   IF node^.left # NIL THEN
  218.    p:= node;  q:= NIL;
  219.    WHILE p # NIL DO  q:= p;  p:= p^.right;  END;
  220.    t:= q^.left;
  221.   ELSIF node^.right # NIL THEN
  222.    p:= node;  q:= NIL;
  223.    WHILE p # NIL DO  q:= p;  p:= p^.left;  END;
  224.    t:= q^.right;
  225.   ELSE
  226.    q:= node;  t:= NIL;
  227.   END;
  228.   IF node = q THEN
  229.    IF node = root THEN  Del (root);
  230.                   ELSE  Putback (node, NIL);  Del (node);
  231.    END;
  232.   ELSE
  233.    Putback (q, t);
  234.    inf:= node^.addr;  node^.addr:= q^.addr;  q^.addr:= inf;
  235.    Del (q);
  236.   END;
  237.  END;
  238.  DEC (tree^.entry);
  239. END DeleteNode;
  240.  
  241. PROCEDURE FirstNode (tree: TREE): NODE;
  242. VAR p, q: NODE;
  243. BEGIN
  244.  IF tree = NIL THEN  RETURN NIL;  END;
  245.  p:= tree^.root;  q:= NIL;
  246.  WHILE p # NIL DO  q:= p;  p:= p^.left;  END;
  247.  RETURN q;
  248. END FirstNode;
  249.  
  250. PROCEDURE LastNode (tree: TREE): NODE;
  251. VAR p, q: NODE;
  252. BEGIN
  253.  IF tree = NIL THEN  RETURN NIL;  END;
  254.  p:= tree^.root;  q:= NIL;
  255.  WHILE p # NIL DO  q:= p;  p:= p^.right;  END;
  256.  RETURN q;
  257. END LastNode;
  258.  
  259. PROCEDURE NextNode (node: NODE): NODE;
  260. VAR p, q: NODE;
  261.     ok:   BOOLEAN;
  262. BEGIN
  263.  IF node = NIL THEN  RETURN NIL;  END;
  264.  IF node^.right # NIL THEN
  265.   p:= node^.right;  q:= NIL;
  266.   WHILE p # NIL DO  q:= p;  p:= p^.left;  END;
  267.   RETURN q;
  268.  ELSE
  269.   ok:= FALSE;  p:= node;
  270.   REPEAT
  271.    q:= p;  p:= p^.back;
  272.    IF p = NIL THEN  ok:= TRUE;
  273.               ELSE  ok:= p^.left = q;
  274.    END;
  275.   UNTIL ok;
  276.   RETURN p;
  277.  END;
  278. END NextNode;
  279.  
  280. PROCEDURE PrevNode (node: NODE): NODE;
  281. VAR ok:   BOOLEAN;
  282.     p, q: NODE;
  283. BEGIN
  284.  IF node = NIL THEN  RETURN NIL;  END;
  285.  IF node^.left # NIL THEN
  286.   p:= node^.left;  q:= NIL;
  287.   WHILE p # NIL DO  q:= p;  p:= p^.right;  END;
  288.   RETURN q;
  289.  ELSE
  290.   ok:= FALSE;  p:= node;
  291.   REPEAT
  292.    q:= p;  p:= p^.back;
  293.    IF p = NIL THEN  ok:= TRUE;
  294.               ELSE  ok:= p^.right = q;
  295.    END;
  296.   UNTIL ok;
  297.   RETURN p;
  298.  END;
  299. END PrevNode;
  300.  
  301. PROCEDURE GetNode (node: NODE; VAR info: ARRAY OF LOC): BOOLEAN;
  302. BEGIN
  303.  IF node = NIL THEN  RETURN FALSE;  END;
  304.  IF HIGH (info) < node^.size THEN  RETURN FALSE;  END;
  305.  Copy (node^.addr, ADR(info), node^.size);
  306.  RETURN TRUE;
  307. END GetNode;
  308.  
  309. END mtTrees.
  310.  
  311.